more OsPath conversion

keyFile has a nice improvement; since a Key is a ShortByteString, it can
be converted to an OsPath without needing the copy that was done before.

Unfortunately, fileKey has to convert from a ShortByteString to a
ByteString in order to use attoparsec, and then the results get
converted back to an OsPath, so there are now 2 copies.
Maybe attoparsec will eventually get a ShortByteString API,
see https://github.com/haskell/attoparsec/issues/225

Sponsored-by: Joshua Antonishen

diff --git a/Annex/Locations.hs b/Annex/Locations.hs
index 1e4593ca9c8ec0604b989740c39768731fe5788c..ce05056b3f50e6d298467dfb60f7c82962b1f5c8 100644 (file)
--- a/Annex/Locations.hs
+++ b/Annex/Locations.hs
@@ -120,7 +120,7 @@ import Data.Char
 import Data.Default
 import qualified Data.List.NonEmpty as NE
 import qualified Data.ByteString.Char8 as S8
-import qualified System.FilePath.ByteString as P
+import qualified Data.ByteString.Short as SB
 
 import Common
 import Key
@@ -134,7 +134,6 @@ import qualified Git.Types as Git
 import Git.FilePath
 import Annex.DirHashes
 import Annex.Fixup
-import qualified Utility.RawFilePath as R
 
 {- Conventions:
  -
@@ -170,7 +169,7 @@ annexLocationsNonBare config key =
        map (annexLocation config key) [hashDirMixed, hashDirLower]
 
 {- Annexed file's possible locations relative to a bare repository. -}
-annexLocationsBare :: GitConfig -> Key -> [RawFilePath]
+annexLocationsBare :: GitConfig -> Key -> [OsPath]
 annexLocationsBare config key = 
        map (annexLocation config key) [hashDirLower, hashDirMixed]
 
@@ -182,7 +181,7 @@ annexLocation config key hasher = objectDir </> keyPath key (hasher $ objectHash
 exportAnnexObjectLocation :: GitConfig -> Key -> ExportLocation
 exportAnnexObjectLocation gc k =
        mkExportLocation $
-               literalOsPath ".git" P.</> annexLocation gc k hashDirLower
+               literalOsPath ".git" </> annexLocation gc k hashDirLower
 
 {- Number of subdirectories from the gitAnnexObjectDir
  - to the gitAnnexLocation. -}
@@ -199,17 +198,17 @@ gitAnnexLocationDepth config = hashlevels + 1
  - When the file is not present, returns the location where the file should
  - be stored.
  -}
-gitAnnexLocation :: Key -> Git.Repo -> GitConfig -> IO RawFilePath
-gitAnnexLocation = gitAnnexLocation' R.doesPathExist
+gitAnnexLocation :: Key -> Git.Repo -> GitConfig -> IO OsPath
+gitAnnexLocation = gitAnnexLocation' doesPathExist
 
-gitAnnexLocation' :: (RawFilePath -> IO Bool) -> Key -> Git.Repo -> GitConfig -> IO RawFilePath
+gitAnnexLocation' :: (OsPath -> IO Bool) -> Key -> Git.Repo -> GitConfig -> IO OsPath
 gitAnnexLocation' checker key r config = gitAnnexLocation'' key r config
        (annexCrippledFileSystem config)
        (coreSymlinks config)
        checker
        (Git.localGitDir r)
 
-gitAnnexLocation'' :: Key -> Git.Repo -> GitConfig -> Bool -> Bool -> (RawFilePath -> IO Bool) -> RawFilePath -> IO RawFilePath
+gitAnnexLocation'' :: Key -> Git.Repo -> GitConfig -> Bool -> Bool -> (OsPath -> IO Bool) -> OsPath -> IO OsPath
 gitAnnexLocation'' key r config crippled symlinkssupported checker gitdir
        {- Bare repositories default to hashDirLower for new
         - content, as it's more portable. But check all locations. -}
@@ -228,14 +227,14 @@ gitAnnexLocation'' key r config crippled symlinkssupported checker gitdir
        only = return . inrepo . annexLocation config key
        checkall f = check $ map inrepo $ f config key
 
-       inrepo d = gitdir P.</> d
+       inrepo d = gitdir </> d
        check locs@(l:_) = fromMaybe l <$> firstM checker locs
        check [] = error "internal"
 
 {- Calculates a symlink target to link a file to an annexed object. -}
-gitAnnexLink :: RawFilePath -> Key -> Git.Repo -> GitConfig -> IO RawFilePath
+gitAnnexLink :: OsPath -> Key -> Git.Repo -> GitConfig -> IO OsPath
 gitAnnexLink file key r config = do
-       currdir <- R.getCurrentDirectory
+       currdir <- getCurrentDirectory
        let absfile = absNormPathUnix currdir file
        let gitdir = getgitdir currdir
        loc <- gitAnnexLocation'' key r config False False (\_ -> return True) gitdir
@@ -246,19 +245,19 @@ gitAnnexLink file key r config = do
                 - supporting symlinks; generate link target that will
                 - work portably. -}
                | not (coreSymlinks config) && needsSubmoduleFixup r =
-                       absNormPathUnix currdir (Git.repoPath r P.</> ".git")
+                       absNormPathUnix currdir (Git.repoPath r </> literalOsPath ".git")
                | otherwise = Git.localGitDir r
        absNormPathUnix d p = toInternalGitPath $
                absPathFrom (toInternalGitPath d) (toInternalGitPath p)
 
 {- Calculates a symlink target as would be used in a typical git
  - repository, with .git in the top of the work tree. -}
-gitAnnexLinkCanonical :: RawFilePath -> Key -> Git.Repo -> GitConfig -> IO RawFilePath
+gitAnnexLinkCanonical :: OsPath -> Key -> Git.Repo -> GitConfig -> IO OsPath
 gitAnnexLinkCanonical file key r config = gitAnnexLink file key r' config'
   where
        r' = case r of
                Git.Repo { Git.location = l@Git.Local { Git.worktree = Just wt } } ->
-                       r { Git.location = l { Git.gitdir = wt P.</> ".git" } }
+                       r { Git.location = l { Git.gitdir = wt </> literalOsPath ".git" } }
                _ -> r
        config' = config
                { annexCrippledFileSystem = False
@@ -266,23 +265,23 @@ gitAnnexLinkCanonical file key r config = gitAnnexLink file key r' config'
                }
 
 {- File used to lock a key's content. -}
-gitAnnexContentLock :: Key -> Git.Repo -> GitConfig -> IO RawFilePath
+gitAnnexContentLock :: Key -> Git.Repo -> GitConfig -> IO OsPath
 gitAnnexContentLock key r config = do
        loc <- gitAnnexLocation key r config
-       return $ loc <> ".lck"
+       return $ loc <> literalOsPath ".lck"
 
 {- File used to indicate a key's content should not be dropped until after
  - a specified time. -}
-gitAnnexContentRetentionTimestamp :: Key -> Git.Repo -> GitConfig -> IO RawFilePath
+gitAnnexContentRetentionTimestamp :: Key -> Git.Repo -> GitConfig -> IO OsPath
 gitAnnexContentRetentionTimestamp key r config = do
        loc <- gitAnnexLocation key r config
-       return $ loc <> ".rtm"
+       return $ loc <> literalOsPath ".rtm"
 
 {- Lock file for gitAnnexContentRetentionTimestamp -}
-gitAnnexContentRetentionTimestampLock :: Key -> Git.Repo -> GitConfig -> IO RawFilePath
+gitAnnexContentRetentionTimestampLock :: Key -> Git.Repo -> GitConfig -> IO OsPath
 gitAnnexContentRetentionTimestampLock key r config = do
        loc <- gitAnnexLocation key r config
-       return $ loc <> ".rtl"
+       return $ loc <> literalOsPath ".rtl"
 
 {- Lock that is held when taking the gitAnnexContentLock to support the v10
  - upgrade.
@@ -292,52 +291,52 @@ gitAnnexContentRetentionTimestampLock key r config = do
  - is mounted read-only. The gitAnnexInodeSentinal is created by git-annex
  - init, so should already exist.
  -}
-gitAnnexContentLockLock :: Git.Repo -> RawFilePath
+gitAnnexContentLockLock :: Git.Repo -> OsPath
 gitAnnexContentLockLock = gitAnnexInodeSentinal
 
-gitAnnexInodeSentinal :: Git.Repo -> RawFilePath
-gitAnnexInodeSentinal r = gitAnnexDir r P.</> "sentinal"
+gitAnnexInodeSentinal :: Git.Repo -> OsPath
+gitAnnexInodeSentinal r = gitAnnexDir r </> literalOsPath "sentinal"
 
-gitAnnexInodeSentinalCache :: Git.Repo -> RawFilePath
-gitAnnexInodeSentinalCache r = gitAnnexInodeSentinal r <> ".cache"
+gitAnnexInodeSentinalCache :: Git.Repo -> OsPath
+gitAnnexInodeSentinalCache r = gitAnnexInodeSentinal r <> literalOsPath ".cache"
 
 {- The annex directory of a repository. -}
-gitAnnexDir :: Git.Repo -> RawFilePath
-gitAnnexDir r = P.addTrailingPathSeparator $ Git.localGitDir r P.</> annexDir
+gitAnnexDir :: Git.Repo -> OsPath
+gitAnnexDir r = addTrailingPathSeparator $ Git.localGitDir r </> annexDir
 
 {- The part of the annex directory where file contents are stored. -}
-gitAnnexObjectDir :: Git.Repo -> RawFilePath
-gitAnnexObjectDir r = P.addTrailingPathSeparator $
-       Git.localGitDir r P.</> objectDir
+gitAnnexObjectDir :: Git.Repo -> OsPath
+gitAnnexObjectDir r = addTrailingPathSeparator $
+       Git.localGitDir r </> objectDir
 
 {- .git/annex/tmp/ is used for temp files for key's contents -}
-gitAnnexTmpObjectDir :: Git.Repo -> RawFilePath
-gitAnnexTmpObjectDir r = P.addTrailingPathSeparator $
-       gitAnnexDir r P.</> "tmp"
+gitAnnexTmpObjectDir :: Git.Repo -> OsPath
+gitAnnexTmpObjectDir r = addTrailingPathSeparator $
+       gitAnnexDir r </> literalOsPath "tmp"
 
 {- .git/annex/othertmp/ is used for other temp files -}
-gitAnnexTmpOtherDir :: Git.Repo -> RawFilePath
-gitAnnexTmpOtherDir r = P.addTrailingPathSeparator $
-       gitAnnexDir r P.</> "othertmp"
+gitAnnexTmpOtherDir :: Git.Repo -> OsPath
+gitAnnexTmpOtherDir r = addTrailingPathSeparator $
+       gitAnnexDir r </> literalOsPath "othertmp"
 
 {- Lock file for gitAnnexTmpOtherDir. -}
-gitAnnexTmpOtherLock :: Git.Repo -> RawFilePath
-gitAnnexTmpOtherLock r = gitAnnexDir r P.</> "othertmp.lck"
+gitAnnexTmpOtherLock :: Git.Repo -> OsPath
+gitAnnexTmpOtherLock r = gitAnnexDir r </> literalOsPath "othertmp.lck"
 
 {- .git/annex/misctmp/ was used by old versions of git-annex and is still
  - used during initialization -}
-gitAnnexTmpOtherDirOld :: Git.Repo -> RawFilePath
-gitAnnexTmpOtherDirOld r = P.addTrailingPathSeparator $ 
-       gitAnnexDir r P.</> "misctmp"
+gitAnnexTmpOtherDirOld :: Git.Repo -> OsPath
+gitAnnexTmpOtherDirOld r = addTrailingPathSeparator $ 
+       gitAnnexDir r </> literalOsPath "misctmp"
 
 {- .git/annex/watchtmp/ is used by the watcher and assistant -}
-gitAnnexTmpWatcherDir :: Git.Repo -> RawFilePath
-gitAnnexTmpWatcherDir r = P.addTrailingPathSeparator $
-       gitAnnexDir r P.</> "watchtmp"
+gitAnnexTmpWatcherDir :: Git.Repo -> OsPath
+gitAnnexTmpWatcherDir r = addTrailingPathSeparator $
+       gitAnnexDir r </> literalOsPath "watchtmp"
 
 {- The temp file to use for a given key's content. -}
-gitAnnexTmpObjectLocation :: Key -> Git.Repo -> RawFilePath
-gitAnnexTmpObjectLocation key r = gitAnnexTmpObjectDir r P.</> keyFile key
+gitAnnexTmpObjectLocation :: Key -> Git.Repo -> OsPath
+gitAnnexTmpObjectLocation key r = gitAnnexTmpObjectDir r </> keyFile key
 
 {- Given a temp file such as gitAnnexTmpObjectLocation, makes a name for a
  - subdirectory in the same location, that can be used as a work area
@@ -346,339 +345,353 @@ gitAnnexTmpObjectLocation key r = gitAnnexTmpObjectDir r P.</> keyFile key
  - There are ordering requirements for creating these directories;
  - use Annex.Content.withTmpWorkDir to set them up.
  -}
-gitAnnexTmpWorkDir :: RawFilePath -> RawFilePath
+gitAnnexTmpWorkDir :: OsPath -> OsPath
 gitAnnexTmpWorkDir p =
-       let (dir, f) = P.splitFileName p
+       let (dir, f) = splitFileName p
        -- Using a prefix avoids name conflict with any other keys.
-       in dir P.</> "work." <> f
+       in dir </> literalOsPath "work." <> f
 
 {- .git/annex/bad/ is used for bad files found during fsck -}
-gitAnnexBadDir :: Git.Repo -> RawFilePath
-gitAnnexBadDir r = P.addTrailingPathSeparator $ gitAnnexDir r P.</> "bad"
+gitAnnexBadDir :: Git.Repo -> OsPath
+gitAnnexBadDir r = addTrailingPathSeparator $
+       gitAnnexDir r </> literalOsPath "bad"
 
 {- The bad file to use for a given key. -}
-gitAnnexBadLocation :: Key -> Git.Repo -> RawFilePath
-gitAnnexBadLocation key r = gitAnnexBadDir r P.</> keyFile key
+gitAnnexBadLocation :: Key -> Git.Repo -> OsPath
+gitAnnexBadLocation key r = gitAnnexBadDir r </> keyFile key
 
 {- .git/annex/foounused is used to number possibly unused keys -}
-gitAnnexUnusedLog :: RawFilePath -> Git.Repo -> RawFilePath
-gitAnnexUnusedLog prefix r = gitAnnexDir r P.</> (prefix <> "unused")
+gitAnnexUnusedLog :: OsPath -> Git.Repo -> OsPath
+gitAnnexUnusedLog prefix r =
+       gitAnnexDir r </> (prefix <> literalOsPath "unused")
 
 {- .git/annex/keysdb/ contains a database of information about keys. -}
-gitAnnexKeysDbDir :: Git.Repo -> GitConfig -> RawFilePath
-gitAnnexKeysDbDir r c = fromMaybe (gitAnnexDir r) (annexDbDir c) P.</> "keysdb"
+gitAnnexKeysDbDir :: Git.Repo -> GitConfig -> OsPath
+gitAnnexKeysDbDir r c = 
+       fromMaybe (gitAnnexDir r) (annexDbDir c) </> literalOsPath "keysdb"
 
 {- Lock file for the keys database. -}
-gitAnnexKeysDbLock :: Git.Repo -> GitConfig -> RawFilePath
-gitAnnexKeysDbLock r c = gitAnnexKeysDbDir r c <> ".lck"
+gitAnnexKeysDbLock :: Git.Repo -> GitConfig -> OsPath
+gitAnnexKeysDbLock r c = gitAnnexKeysDbDir r c <> literalOsPath ".lck"
 
 {- Contains the stat of the last index file that was
  - reconciled with the keys database. -}
-gitAnnexKeysDbIndexCache :: Git.Repo -> GitConfig -> RawFilePath
-gitAnnexKeysDbIndexCache r c = gitAnnexKeysDbDir r c <> ".cache"
+gitAnnexKeysDbIndexCache :: Git.Repo -> GitConfig -> OsPath
+gitAnnexKeysDbIndexCache r c =
+       gitAnnexKeysDbDir r c <> literalOsPath ".cache"
 
 {- .git/annex/fsck/uuid/ is used to store information about incremental
  - fscks. -}
-gitAnnexFsckDir :: UUID -> Git.Repo -> Maybe GitConfig -> RawFilePath
+gitAnnexFsckDir :: UUID -> Git.Repo -> Maybe GitConfig -> OsPath
 gitAnnexFsckDir u r mc = case annexDbDir =<< mc of
        Nothing -> go (gitAnnexDir r)
        Just d -> go d
   where
-       go d = d P.</> "fsck" P.</> fromUUID u
+       go d = d </> literalOsPath "fsck" </> uuidPath u
 
 {- used to store information about incremental fscks. -}
-gitAnnexFsckState :: UUID -> Git.Repo -> RawFilePath
-gitAnnexFsckState u r = gitAnnexFsckDir u r Nothing P.</> "state"
+gitAnnexFsckState :: UUID -> Git.Repo -> OsPath
+gitAnnexFsckState u r = gitAnnexFsckDir u r Nothing </> literalOsPath "state"
 
 {- Directory containing database used to record fsck info. -}
-gitAnnexFsckDbDir :: UUID -> Git.Repo -> GitConfig -> RawFilePath
-gitAnnexFsckDbDir u r c = gitAnnexFsckDir u r (Just c) P.</> "fsckdb"
+gitAnnexFsckDbDir :: UUID -> Git.Repo -> GitConfig -> OsPath
+gitAnnexFsckDbDir u r c = gitAnnexFsckDir u r (Just c) </> literalOsPath "fsckdb"
 
 {- Directory containing old database used to record fsck info. -}
-gitAnnexFsckDbDirOld :: UUID -> Git.Repo -> GitConfig -> RawFilePath
-gitAnnexFsckDbDirOld u r c = gitAnnexFsckDir u r (Just c) P.</> "db"
+gitAnnexFsckDbDirOld :: UUID -> Git.Repo -> GitConfig -> OsPath
+gitAnnexFsckDbDirOld u r c = gitAnnexFsckDir u r (Just c) </> literalOsPath "db"
 
 {- Lock file for the fsck database. -}
-gitAnnexFsckDbLock :: UUID -> Git.Repo -> GitConfig -> RawFilePath
-gitAnnexFsckDbLock u r c = gitAnnexFsckDir u r (Just c) P.</> "fsck.lck"
+gitAnnexFsckDbLock :: UUID -> Git.Repo -> GitConfig -> OsPath
+gitAnnexFsckDbLock u r c = gitAnnexFsckDir u r (Just c) </> literalOsPath "fsck.lck"
 
 {- .git/annex/fsckresults/uuid is used to store results of git fscks -}
-gitAnnexFsckResultsLog :: UUID -> Git.Repo -> RawFilePath
+gitAnnexFsckResultsLog :: UUID -> Git.Repo -> OsPath
 gitAnnexFsckResultsLog u r = 
-       gitAnnexDir r P.</> "fsckresults" P.</> fromUUID u
+       gitAnnexDir r </> literalOsPath "fsckresults" </> uuidPath u
 
 {- .git/annex/upgrade.log is used to record repository version upgrades. -}
-gitAnnexUpgradeLog :: Git.Repo -> RawFilePath
-gitAnnexUpgradeLog r = gitAnnexDir r P.</> "upgrade.log"
+gitAnnexUpgradeLog :: Git.Repo -> OsPath
+gitAnnexUpgradeLog r = gitAnnexDir r </> literalOsPath "upgrade.log"
 
-gitAnnexUpgradeLock :: Git.Repo -> RawFilePath
-gitAnnexUpgradeLock r = gitAnnexDir r P.</> "upgrade.lck"
+gitAnnexUpgradeLock :: Git.Repo -> OsPath
+gitAnnexUpgradeLock r = gitAnnexDir r </> literalOsPath "upgrade.lck"
 
 {- .git/annex/smudge.log is used to log smudged worktree files that need to
  - be updated. -}
-gitAnnexSmudgeLog :: Git.Repo -> RawFilePath
-gitAnnexSmudgeLog r = gitAnnexDir r P.</> "smudge.log"
+gitAnnexSmudgeLog :: Git.Repo -> OsPath
+gitAnnexSmudgeLog r = gitAnnexDir r </> literalOsPath "smudge.log"
 
-gitAnnexSmudgeLock :: Git.Repo -> RawFilePath
-gitAnnexSmudgeLock r = gitAnnexDir r P.</> "smudge.lck"
+gitAnnexSmudgeLock :: Git.Repo -> OsPath
+gitAnnexSmudgeLock r = gitAnnexDir r </> literalOsPath "smudge.lck"
 
 {- .git/annex/restage.log is used to log worktree files that need to be
  - restaged in git -}
-gitAnnexRestageLog :: Git.Repo -> RawFilePath
-gitAnnexRestageLog r = gitAnnexDir r P.</> "restage.log"
+gitAnnexRestageLog :: Git.Repo -> OsPath
+gitAnnexRestageLog r = gitAnnexDir r </> literalOsPath "restage.log"
 
 {- .git/annex/restage.old is used while restaging files in git -}
-gitAnnexRestageLogOld :: Git.Repo -> RawFilePath
-gitAnnexRestageLogOld r = gitAnnexDir r P.</> "restage.old"
+gitAnnexRestageLogOld :: Git.Repo -> OsPath
+gitAnnexRestageLogOld r = gitAnnexDir r </> literalOsPath "restage.old"
 
-gitAnnexRestageLock :: Git.Repo -> RawFilePath
-gitAnnexRestageLock r = gitAnnexDir r P.</> "restage.lck"
+gitAnnexRestageLock :: Git.Repo -> OsPath
+gitAnnexRestageLock r = gitAnnexDir r </> literalOsPath "restage.lck"
 
 {- .git/annex/adjust.log is used to log when the adjusted branch needs to
  - be updated. -}
-gitAnnexAdjustedBranchUpdateLog :: Git.Repo -> RawFilePath
-gitAnnexAdjustedBranchUpdateLog r = gitAnnexDir r P.</> "adjust.log"
+gitAnnexAdjustedBranchUpdateLog :: Git.Repo -> OsPath
+gitAnnexAdjustedBranchUpdateLog r = gitAnnexDir r </> literalOsPath "adjust.log"
 
-gitAnnexAdjustedBranchUpdateLock :: Git.Repo -> RawFilePath
-gitAnnexAdjustedBranchUpdateLock r = gitAnnexDir r P.</> "adjust.lck"
+gitAnnexAdjustedBranchUpdateLock :: Git.Repo -> OsPath
+gitAnnexAdjustedBranchUpdateLock r = gitAnnexDir r </> literalOsPath "adjust.lck"
 
 {- .git/annex/migrate.log is used to log migrations before committing them. -}
-gitAnnexMigrateLog :: Git.Repo -> RawFilePath
-gitAnnexMigrateLog r = gitAnnexDir r P.</> "migrate.log"
+gitAnnexMigrateLog :: Git.Repo -> OsPath
+gitAnnexMigrateLog r = gitAnnexDir r </> literalOsPath "migrate.log"
 
-gitAnnexMigrateLock :: Git.Repo -> RawFilePath
-gitAnnexMigrateLock r = gitAnnexDir r P.</> "migrate.lck"
+gitAnnexMigrateLock :: Git.Repo -> OsPath
+gitAnnexMigrateLock r = gitAnnexDir r </> literalOsPath "migrate.lck"
 
 {- .git/annex/migrations.log is used to log committed migrations. -}
-gitAnnexMigrationsLog :: Git.Repo -> RawFilePath
-gitAnnexMigrationsLog r = gitAnnexDir r P.</> "migrations.log"
+gitAnnexMigrationsLog :: Git.Repo -> OsPath
+gitAnnexMigrationsLog r = gitAnnexDir r </> literalOsPath "migrations.log"
 
-gitAnnexMigrationsLock :: Git.Repo -> RawFilePath
-gitAnnexMigrationsLock r = gitAnnexDir r P.</> "migrations.lck"
+gitAnnexMigrationsLock :: Git.Repo -> OsPath
+gitAnnexMigrationsLock r = gitAnnexDir r </> literalOsPath "migrations.lck"
 
 {- .git/annex/move.log is used to log moves that are in progress,
  - to better support resuming an interrupted move. -}
-gitAnnexMoveLog :: Git.Repo -> RawFilePath
-gitAnnexMoveLog r = gitAnnexDir r P.</> "move.log"
+gitAnnexMoveLog :: Git.Repo -> OsPath
+gitAnnexMoveLog r = gitAnnexDir r </> literalOsPath "move.log"
 
-gitAnnexMoveLock :: Git.Repo -> RawFilePath
-gitAnnexMoveLock r = gitAnnexDir r P.</> "move.lck"
+gitAnnexMoveLock :: Git.Repo -> OsPath
+gitAnnexMoveLock r = gitAnnexDir r </> literalOsPath "move.lck"
 
 {- .git/annex/export/ is used to store information about
  - exports to special remotes. -}
-gitAnnexExportDir :: Git.Repo -> GitConfig -> RawFilePath
-gitAnnexExportDir r c = fromMaybe (gitAnnexDir r) (annexDbDir c) P.</> "export"
+gitAnnexExportDir :: Git.Repo -> GitConfig -> OsPath
+gitAnnexExportDir r c = fromMaybe (gitAnnexDir r) (annexDbDir c)
+       </> literalOsPath "export"
 
 {- Directory containing database used to record export info. -}
-gitAnnexExportDbDir :: UUID -> Git.Repo -> GitConfig -> RawFilePath
+gitAnnexExportDbDir :: UUID -> Git.Repo -> GitConfig -> OsPath
 gitAnnexExportDbDir u r c = 
-       gitAnnexExportDir r c P.</> fromUUID u P.</> "exportdb"
+       gitAnnexExportDir r c </> uuidPath u </> literalOsPath "exportdb"
 
 {- Lock file for export database. -}
-gitAnnexExportLock :: UUID -> Git.Repo -> GitConfig -> RawFilePath
-gitAnnexExportLock u r c = gitAnnexExportDbDir u r c <> ".lck"
+gitAnnexExportLock :: UUID -> Git.Repo -> GitConfig -> OsPath
+gitAnnexExportLock u r c = gitAnnexExportDbDir u r c <> literalOsPath ".lck"
 
 {- Lock file for updating the export database with information from the
  - repository. -}
-gitAnnexExportUpdateLock :: UUID -> Git.Repo -> GitConfig -> RawFilePath
-gitAnnexExportUpdateLock u r c = gitAnnexExportDbDir u r c <> ".upl"
+gitAnnexExportUpdateLock :: UUID -> Git.Repo -> GitConfig -> OsPath
+gitAnnexExportUpdateLock u r c = gitAnnexExportDbDir u r c <> literalOsPath ".upl"
 
 {- Log file used to keep track of files that were in the tree exported to a
  - remote, but were excluded by its preferred content settings. -}
-gitAnnexExportExcludeLog :: UUID -> Git.Repo -> RawFilePath
-gitAnnexExportExcludeLog u r = gitAnnexDir r P.</> "export.ex" P.</> fromUUID u
+gitAnnexExportExcludeLog :: UUID -> Git.Repo -> OsPath
+gitAnnexExportExcludeLog u r = gitAnnexDir r 
+       </> literalOsPath "export.ex" </> uuidPath u
 
 {- Directory containing database used to record remote content ids.
  -
  - (This used to be "cid", but a problem with the database caused it to
  - need to be rebuilt with a new name.)
  -}
-gitAnnexContentIdentifierDbDir :: Git.Repo -> GitConfig -> RawFilePath
+gitAnnexContentIdentifierDbDir :: Git.Repo -> GitConfig -> OsPath
 gitAnnexContentIdentifierDbDir r c =
-       fromMaybe (gitAnnexDir r) (annexDbDir c) P.</> "cidsdb"
+       fromMaybe (gitAnnexDir r) (annexDbDir c) </> literalOsPath "cidsdb"
 
 {- Lock file for writing to the content id database. -}
-gitAnnexContentIdentifierLock :: Git.Repo -> GitConfig -> RawFilePath
-gitAnnexContentIdentifierLock r c = gitAnnexContentIdentifierDbDir r c <> ".lck"
+gitAnnexContentIdentifierLock :: Git.Repo -> GitConfig -> OsPath
+gitAnnexContentIdentifierLock r c = 
+       gitAnnexContentIdentifierDbDir r c <> literalOsPath ".lck"
 
 {- .git/annex/import/ is used to store information about
  - imports from special remotes. -}
-gitAnnexImportDir :: Git.Repo -> GitConfig -> RawFilePath
-gitAnnexImportDir r c = fromMaybe (gitAnnexDir r) (annexDbDir c) P.</> "import"
+gitAnnexImportDir :: Git.Repo -> GitConfig -> OsPath
+gitAnnexImportDir r c =
+       fromMaybe (gitAnnexDir r) (annexDbDir c) </> literalOsPath "import"
 
 {- File containing state about the last import done from a remote. -}
-gitAnnexImportLog :: UUID -> Git.Repo -> GitConfig -> RawFilePath
-gitAnnexImportLog u r c = 
-       gitAnnexImportDir r c P.</> fromUUID u P.</> "log"
+gitAnnexImportLog :: UUID -> Git.Repo -> GitConfig -> OsPath
+gitAnnexImportLog u r c =
+       gitAnnexImportDir r c </> uuidPath u </> literalOsPath "log"
 
 {- Directory containing database used by importfeed. -}
-gitAnnexImportFeedDbDir :: Git.Repo -> GitConfig -> RawFilePath
+gitAnnexImportFeedDbDir :: Git.Repo -> GitConfig -> OsPath
 gitAnnexImportFeedDbDir r c =
-       fromMaybe (gitAnnexDir r) (annexDbDir c) P.</> "importfeed"
+       fromMaybe (gitAnnexDir r) (annexDbDir c) </> literalOsPath "importfeed"
 
 {- Lock file for writing to the importfeed database. -}
-gitAnnexImportFeedDbLock :: Git.Repo -> GitConfig -> RawFilePath
-gitAnnexImportFeedDbLock r c = gitAnnexImportFeedDbDir r c <> ".lck"
+gitAnnexImportFeedDbLock :: Git.Repo -> GitConfig -> OsPath
+gitAnnexImportFeedDbLock r c =
+       gitAnnexImportFeedDbDir r c <> literalOsPath ".lck"
 
 {- Directory containing reposize database. -}
-gitAnnexRepoSizeDbDir :: Git.Repo -> GitConfig -> RawFilePath
+gitAnnexRepoSizeDbDir :: Git.Repo -> GitConfig -> OsPath
 gitAnnexRepoSizeDbDir r c =
-       fromMaybe (gitAnnexDir r) (annexDbDir c) P.</> "reposize" P.</> "db"
+       fromMaybe (gitAnnexDir r) (annexDbDir c) </> literalOsPath "reposize" </> literalOsPath "db"
 
 {- Lock file for the reposize database. -}
-gitAnnexRepoSizeDbLock :: Git.Repo -> GitConfig -> RawFilePath
+gitAnnexRepoSizeDbLock :: Git.Repo -> GitConfig -> OsPath
 gitAnnexRepoSizeDbLock r c =
-       fromMaybe (gitAnnexDir r) (annexDbDir c) P.</> "reposize" P.</> "lock"
+       fromMaybe (gitAnnexDir r) (annexDbDir c) </> literalOsPath "reposize" </> literalOsPath "lock"
 
 {- Directory containing liveness pid files. -}
-gitAnnexRepoSizeLiveDir :: Git.Repo -> GitConfig -> RawFilePath
+gitAnnexRepoSizeLiveDir :: Git.Repo -> GitConfig -> OsPath
 gitAnnexRepoSizeLiveDir r c =
-       fromMaybe (gitAnnexDir r) (annexDbDir c) P.</> "reposize" P.</> "live"
+       fromMaybe (gitAnnexDir r) (annexDbDir c) </> literalOsPath "reposize" </> literalOsPath "live"
 
 {- .git/annex/schedulestate is used to store information about when
  - scheduled jobs were last run. -}
-gitAnnexScheduleState :: Git.Repo -> RawFilePath
-gitAnnexScheduleState r = gitAnnexDir r P.</> "schedulestate"
+gitAnnexScheduleState :: Git.Repo -> OsPath
+gitAnnexScheduleState r = gitAnnexDir r </> literalOsPath "schedulestate"
 
 {- .git/annex/creds/ is used to store credentials to access some special
  - remotes. -}
-gitAnnexCredsDir :: Git.Repo -> RawFilePath
-gitAnnexCredsDir r = P.addTrailingPathSeparator $ gitAnnexDir r P.</> "creds"
+gitAnnexCredsDir :: Git.Repo -> OsPath
+gitAnnexCredsDir r = addTrailingPathSeparator $
+       gitAnnexDir r </> literalOsPath "creds"
 
 {- .git/annex/certificate.pem and .git/annex/key.pem are used by the webapp
  - when HTTPS is enabled -}
 gitAnnexWebCertificate :: Git.Repo -> FilePath
-gitAnnexWebCertificate r = fromRawFilePath $ gitAnnexDir r P.</> "certificate.pem"
+gitAnnexWebCertificate r = fromOsPath $
+       gitAnnexDir r </> literalOsPath "certificate.pem"
 gitAnnexWebPrivKey :: Git.Repo -> FilePath
-gitAnnexWebPrivKey r = fromRawFilePath $ gitAnnexDir r P.</> "privkey.pem"
+gitAnnexWebPrivKey r = fromOsPath $
+       gitAnnexDir r </> literalOsPath "privkey.pem"
 
 {- .git/annex/feeds/ is used to record per-key (url) state by importfeed -}
-gitAnnexFeedStateDir :: Git.Repo -> RawFilePath
-gitAnnexFeedStateDir r = P.addTrailingPathSeparator $
-       gitAnnexDir r P.</> "feedstate"
+gitAnnexFeedStateDir :: Git.Repo -> OsPath
+gitAnnexFeedStateDir r = addTrailingPathSeparator $
+       gitAnnexDir r </> literalOsPath "feedstate"
 
-gitAnnexFeedState :: Key -> Git.Repo -> RawFilePath
-gitAnnexFeedState k r = gitAnnexFeedStateDir r P.</> keyFile k
+gitAnnexFeedState :: Key -> Git.Repo -> OsPath
+gitAnnexFeedState k r = gitAnnexFeedStateDir r </> keyFile k
 
 {- .git/annex/merge/ is used as a empty work tree for merges in 
  - adjusted branches. -}
 gitAnnexMergeDir :: Git.Repo -> FilePath
-gitAnnexMergeDir r = fromRawFilePath $
-       P.addTrailingPathSeparator $ gitAnnexDir r P.</> "merge"
+gitAnnexMergeDir r = fromOsPath $
+       addTrailingPathSeparator $ gitAnnexDir r </> literalOsPath "merge"
 
 {- .git/annex/transfer/ is used to record keys currently
  - being transferred, and other transfer bookkeeping info. -}
-gitAnnexTransferDir :: Git.Repo -> RawFilePath
+gitAnnexTransferDir :: Git.Repo -> OsPath
 gitAnnexTransferDir r =
-       P.addTrailingPathSeparator $ gitAnnexDir r P.</> "transfer"
+       addTrailingPathSeparator $ gitAnnexDir r </> literalOsPath "transfer"
 
 {- .git/annex/journal/ is used to journal changes made to the git-annex
  - branch -}
-gitAnnexJournalDir :: BranchState -> Git.Repo -> RawFilePath
-gitAnnexJournalDir st r = P.addTrailingPathSeparator $ 
+gitAnnexJournalDir :: BranchState -> Git.Repo -> OsPath
+gitAnnexJournalDir st r = addTrailingPathSeparator $ 
        case alternateJournal st of
-               Nothing -> gitAnnexDir r P.</> "journal"
+               Nothing -> gitAnnexDir r </> literalOsPath "journal"
                Just d -> d
 
 {- .git/annex/journal.private/ is used to journal changes regarding private
  - repositories. -}
-gitAnnexPrivateJournalDir :: BranchState -> Git.Repo -> RawFilePath
-gitAnnexPrivateJournalDir st r = P.addTrailingPathSeparator $
+gitAnnexPrivateJournalDir :: BranchState -> Git.Repo -> OsPath
+gitAnnexPrivateJournalDir st r = addTrailingPathSeparator $
        case alternateJournal st of
-               Nothing -> gitAnnexDir r P.</> "journal-private"
+               Nothing -> gitAnnexDir r </> literalOsPath "journal-private"
                Just d -> d
 
 {- Lock file for the journal. -}
-gitAnnexJournalLock :: Git.Repo -> RawFilePath
-gitAnnexJournalLock r = gitAnnexDir r P.</> "journal.lck"
+gitAnnexJournalLock :: Git.Repo -> OsPath
+gitAnnexJournalLock r = gitAnnexDir r </> literalOsPath "journal.lck"
 
 {- Lock file for flushing a git queue that writes to the git index or
  - other git state that should only have one writer at a time. -}
-gitAnnexGitQueueLock :: Git.Repo -> RawFilePath
-gitAnnexGitQueueLock r = gitAnnexDir r P.</> "gitqueue.lck"
+gitAnnexGitQueueLock :: Git.Repo -> OsPath
+gitAnnexGitQueueLock r = gitAnnexDir r </> literalOsPath "gitqueue.lck"
 
 {- .git/annex/index is used to stage changes to the git-annex branch -}
-gitAnnexIndex :: Git.Repo -> RawFilePath
-gitAnnexIndex r = gitAnnexDir r P.</> "index"
+gitAnnexIndex :: Git.Repo -> OsPath
+gitAnnexIndex r = gitAnnexDir r </> literalOsPath "index"
 
 {- .git/annex/index-private is used to store information that is not to
  - be exposed to the git-annex branch. -}
-gitAnnexPrivateIndex :: Git.Repo -> RawFilePath
-gitAnnexPrivateIndex r = gitAnnexDir r P.</> "index-private"
+gitAnnexPrivateIndex :: Git.Repo -> OsPath
+gitAnnexPrivateIndex r = gitAnnexDir r </> literalOsPath "index-private"
 
 {- Holds the sha of the git-annex branch that the index was last updated to.
  -
  - The .lck in the name is a historical accident; this is not used as a
  - lock. -}
-gitAnnexIndexStatus :: Git.Repo -> RawFilePath
-gitAnnexIndexStatus r = gitAnnexDir r P.</> "index.lck"
+gitAnnexIndexStatus :: Git.Repo -> OsPath
+gitAnnexIndexStatus r = gitAnnexDir r </> literalOsPath "index.lck"
 
 {- The index file used to generate a filtered branch view._-}
-gitAnnexViewIndex :: Git.Repo -> RawFilePath
-gitAnnexViewIndex r = gitAnnexDir r P.</> "viewindex"
+gitAnnexViewIndex :: Git.Repo -> OsPath
+gitAnnexViewIndex r = gitAnnexDir r </> literalOsPath "viewindex"
 
 {- File containing a log of recently accessed views. -}
-gitAnnexViewLog :: Git.Repo -> RawFilePath
-gitAnnexViewLog r = gitAnnexDir r P.</> "viewlog"
+gitAnnexViewLog :: Git.Repo -> OsPath
+gitAnnexViewLog r = gitAnnexDir r </> literalOsPath "viewlog"
 
 {- List of refs that have already been merged into the git-annex branch. -}
-gitAnnexMergedRefs :: Git.Repo -> RawFilePath
-gitAnnexMergedRefs r = gitAnnexDir r P.</> "mergedrefs"
+gitAnnexMergedRefs :: Git.Repo -> OsPath
+gitAnnexMergedRefs r = gitAnnexDir r </> literalOsPath "mergedrefs"
 
 {- List of refs that should not be merged into the git-annex branch. -}
-gitAnnexIgnoredRefs :: Git.Repo -> RawFilePath
-gitAnnexIgnoredRefs r = gitAnnexDir r P.</> "ignoredrefs"
+gitAnnexIgnoredRefs :: Git.Repo -> OsPath
+gitAnnexIgnoredRefs r = gitAnnexDir r </> literalOsPath "ignoredrefs"
 
 {- Pid file for daemon mode. -}
-gitAnnexPidFile :: Git.Repo -> RawFilePath
-gitAnnexPidFile r = gitAnnexDir r P.</> "daemon.pid"
+gitAnnexPidFile :: Git.Repo -> OsPath
+gitAnnexPidFile r = gitAnnexDir r </> literalOsPath "daemon.pid"
 
 {- Pid lock file for pidlock mode -}
-gitAnnexPidLockFile :: Git.Repo -> RawFilePath
-gitAnnexPidLockFile r = gitAnnexDir r P.</> "pidlock"
+gitAnnexPidLockFile :: Git.Repo -> OsPath
+gitAnnexPidLockFile r = gitAnnexDir r </> literalOsPath "pidlock"
 
 {- Status file for daemon mode. -}
 gitAnnexDaemonStatusFile :: Git.Repo -> FilePath
-gitAnnexDaemonStatusFile r = fromRawFilePath $
-       gitAnnexDir r P.</> "daemon.status"
+gitAnnexDaemonStatusFile r = fromOsPath $
+       gitAnnexDir r </> literalOsPath "daemon.status"
 
 {- Log file for daemon mode. -}
-gitAnnexDaemonLogFile :: Git.Repo -> RawFilePath
-gitAnnexDaemonLogFile r = gitAnnexDir r P.</> "daemon.log"
+gitAnnexDaemonLogFile :: Git.Repo -> OsPath
+gitAnnexDaemonLogFile r = gitAnnexDir r </> literalOsPath "daemon.log"
 
 {- Log file for fuzz test. -}
 gitAnnexFuzzTestLogFile :: Git.Repo -> FilePath
-gitAnnexFuzzTestLogFile r = fromRawFilePath $
-       gitAnnexDir r P.</> "fuzztest.log"
+gitAnnexFuzzTestLogFile r = fromOsPath $
+       gitAnnexDir r </> literalOsPath "fuzztest.log"
 
 {- Html shim file used to launch the webapp. -}
-gitAnnexHtmlShim :: Git.Repo -> RawFilePath
-gitAnnexHtmlShim r = gitAnnexDir r P.</> "webapp.html"
+gitAnnexHtmlShim :: Git.Repo -> OsPath
+gitAnnexHtmlShim r = gitAnnexDir r </> literalOsPath "webapp.html"
 
 {- File containing the url to the webapp. -}
-gitAnnexUrlFile :: Git.Repo -> RawFilePath
-gitAnnexUrlFile r = gitAnnexDir r P.</> "url"
+gitAnnexUrlFile :: Git.Repo -> OsPath
+gitAnnexUrlFile r = gitAnnexDir r </> literalOsPath "url"
 
 {- Temporary file used to edit configuriation from the git-annex branch. -}
-gitAnnexTmpCfgFile :: Git.Repo -> RawFilePath
-gitAnnexTmpCfgFile r = gitAnnexDir r P.</> "config.tmp"
+gitAnnexTmpCfgFile :: Git.Repo -> OsPath
+gitAnnexTmpCfgFile r = gitAnnexDir r </> literalOsPath "config.tmp"
 
 {- .git/annex/ssh/ is used for ssh connection caching -}
-gitAnnexSshDir :: Git.Repo -> RawFilePath
-gitAnnexSshDir r = P.addTrailingPathSeparator $ gitAnnexDir r P.</> "ssh"
+gitAnnexSshDir :: Git.Repo -> OsPath
+gitAnnexSshDir r = addTrailingPathSeparator $
+       gitAnnexDir r </> literalOsPath "ssh"
 
 {- .git/annex/remotes/ is used for remote-specific state. -}
-gitAnnexRemotesDir :: Git.Repo -> RawFilePath
-gitAnnexRemotesDir r =
-       P.addTrailingPathSeparator $ gitAnnexDir r P.</> "remotes"
+gitAnnexRemotesDir :: Git.Repo -> OsPath
+gitAnnexRemotesDir r = addTrailingPathSeparator $
+       gitAnnexDir r </> literalOsPath "remotes"
 
 {- This is the base directory name used by the assistant when making
  - repositories, by default. -}
 gitAnnexAssistantDefaultDir :: FilePath
 gitAnnexAssistantDefaultDir = "annex"
 
-gitAnnexSimDir :: Git.Repo -> RawFilePath
-gitAnnexSimDir r = P.addTrailingPathSeparator $ gitAnnexDir r P.</> "sim"
+gitAnnexSimDir :: Git.Repo -> OsPath
+gitAnnexSimDir r = addTrailingPathSeparator $
+       gitAnnexDir r </> literalOsPath "sim"
 
 {- Sanitizes a String that will be used as part of a Key's keyName,
  - dealing with characters that cause problems.
@@ -730,23 +743,26 @@ reSanitizeKeyName = preSanitizeKeyName' True
  - Changing what this function escapes and how is not a good idea, as it
  - can cause existing objects to get lost.
  -}
-keyFile :: Key -> RawFilePath
+keyFile :: Key -> OsPath
 keyFile k = 
-       let b = serializeKey' k
-       in if S8.any (`elem` ['&', '%', ':', '/']) b
-               then S8.concatMap esc b
+       let b = serializeKey'' k
+       in toOsPath $ if SB.any (`elem` needesc) b
+               then SB.concat $ map esc (SB.unpack b)
                else b
   where
-       esc '&' = "&a"
-       esc '%' = "&s"
-       esc ':' = "&c"
-       esc '/' = "%"
-       esc c = S8.singleton c
+       esc w = case chr (fromIntegral w) of
+               '&' -> "&a"
+               '%' -> "&s"
+               ':' -> "&c"
+               '/' -> "%"
+               _ -> SB.singleton w
+
+       needesc = map (fromIntegral . ord) ['&', '%', ':', '/']
 
 {- Reverses keyFile, converting a filename fragment (ie, the basename of
  - the symlink target) into a key. -}
-fileKey :: RawFilePath -> Maybe Key
-fileKey = deserializeKey' . S8.intercalate "/" . map go . S8.split '%'
+fileKey :: OsPath -> Maybe Key
+fileKey = deserializeKey' . S8.intercalate "/" . map go . S8.split '%' . fromOsPath
   where
        go = S8.concat . unescafterfirst . S8.split '&'
        unescafterfirst [] = []
@@ -765,8 +781,8 @@ fileKey = deserializeKey' . S8.intercalate "/" . map go . S8.split '%'
  - The file is put in a directory with the same name, this allows
  - write-protecting the directory to avoid accidental deletion of the file.
  -}
-keyPath :: Key -> Hasher -> RawFilePath
-keyPath key hasher = hasher key P.</> f P.</> f
+keyPath :: Key -> Hasher -> OsPath
+keyPath key hasher = hasher key </> f </> f
   where
        f = keyFile key
 
@@ -776,5 +792,9 @@ keyPath key hasher = hasher key P.</> f P.</> f
  - This is compatible with the annexLocationsNonBare and annexLocationsBare,
  - for interoperability between special remotes and git-annex repos.
  -}
-keyPaths :: Key -> NE.NonEmpty RawFilePath
+keyPaths :: Key -> NE.NonEmpty OsPath
 keyPaths key = NE.map (\h -> keyPath key (h def)) dirHashes
+
+uuidPath :: UUID -> OsPath
+uuidPath u = toOsPath (fromUUID u :: SB.ShortByteString)
+

diff --git a/Key.hs b/Key.hs
index b19aee8040824882ae9b2785b5611dcbced6efc8..c4f7d062e33248dd5eb5afc907ab1509b160a59d 100644 (file)
--- a/Key.hs
+++ b/Key.hs
@@ -18,6 +18,7 @@ module Key (
        keyParser,
        serializeKey,
        serializeKey',
+       serializeKey'',
        deserializeKey,
        deserializeKey',
        nonChunkKey,
@@ -31,7 +32,7 @@ module Key (
 
 import qualified Data.Text as T
 import qualified Data.ByteString as S
-import qualified Data.ByteString.Short as S (toShort, fromShort)
+import Data.ByteString.Short (ShortByteString, toShort, fromShort)
 import qualified Data.Attoparsec.ByteString as A
 
 import Common
@@ -63,7 +64,10 @@ serializeKey :: Key -> String
 serializeKey = decodeBS . serializeKey'
 
 serializeKey' :: Key -> S.ByteString
-serializeKey' = S.fromShort . keySerialization
+serializeKey' = fromShort . keySerialization
+
+serializeKey'' :: Key -> ShortByteString
+serializeKey'' = keySerialization
 
 deserializeKey :: String -> Maybe Key
 deserializeKey = deserializeKey' . encodeBS
@@ -73,7 +77,7 @@ deserializeKey' = eitherToMaybe . A.parseOnly keyParser
 
 instance Arbitrary KeyData where
        arbitrary = Key
-               <$> (S.toShort . encodeBS <$> (listOf1 $ elements $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_\r\n \t"))
+               <$> (toShort . encodeBS <$> (listOf1 $ elements $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_\r\n \t"))
                <*> (parseKeyVariety . encodeBS <$> (listOf1 $ elements ['A'..'Z'])) -- BACKEND
                <*> ((abs <$>) <$> arbitrary) -- size cannot be negative
                <*> ((abs . fromInteger <$>) <$> arbitrary) -- mtime cannot be negative

diff --git a/Types/BranchState.hs b/Types/BranchState.hs
index d79a1c70a63cc32dbbcb840d736bbc9b72bf5aeb..069c89c927ec291aed793ad41c9033b2dd6365e5 100644 (file)
--- a/Types/BranchState.hs
+++ b/Types/BranchState.hs
@@ -29,14 +29,14 @@ data BranchState = BranchState
        , unhandledTransitions :: [TransitionCalculator]
        -- ^ when the branch was not able to be updated due to permissions,
        -- this is transitions that need to be applied when making queries.
-       , cachedFileContents :: [(RawFilePath, L.ByteString)]
+       , cachedFileContents :: [(OsPath, L.ByteString)]
        -- ^ contents of a few files recently read from the branch
        , needInteractiveAccess :: Bool
        -- ^ do new changes written to the journal or branch by another
        -- process need to be noticed while the current process is running?
        -- (This makes the journal always be read, and avoids using the
        -- cache.)
-       , alternateJournal :: Maybe RawFilePath
+       , alternateJournal :: Maybe OsPath
        -- ^ use this directory for all journals, rather than the
        -- gitAnnexJournalDir and gitAnnexPrivateJournalDir.
        }

diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs
index 053a9c8c663e1489f29efce9cf4a85614efea0ed..55a5403c5fad8b3a39a4bfc1456b84ed88452883 100644 (file)
--- a/Types/GitConfig.hs
+++ b/Types/GitConfig.hs
@@ -138,7 +138,7 @@ data GitConfig = GitConfig
        , annexVerify :: Bool
        , annexPidLock :: Bool
        , annexPidLockTimeout :: Seconds
-       , annexDbDir :: Maybe RawFilePath
+       , annexDbDir :: Maybe OsPath
        , annexAddUnlocked :: GlobalConfigurable (Maybe String)
        , annexSecureHashesOnly :: Bool
        , annexRetry :: Maybe Integer
@@ -244,7 +244,7 @@ extractGitConfig configsource r = GitConfig
        , annexPidLock = getbool (annexConfig "pidlock") False
        , annexPidLockTimeout = Seconds $ fromMaybe 300 $
                getmayberead (annexConfig "pidlocktimeout")
-       , annexDbDir = (\d -> toRawFilePath d P.</> fromUUID hereuuid)
+       , annexDbDir = (\d -> toOsPath (toRawFilePath d P.</> fromUUID hereuuid))
                <$> getmaybe (annexConfig "dbdir")
        , annexAddUnlocked = configurable Nothing $
                fmap Just $ getmaybe (annexConfig "addunlocked")

diff --git a/Types/UUID.hs b/Types/UUID.hs
index 5d25d57aaf87111f388cfe5bbb9c14c0ecdf1c5e..71ef2b28cde3337f8333f826ea1de4a9637b069e 100644 (file)
--- a/Types/UUID.hs
+++ b/Types/UUID.hs
@@ -10,6 +10,7 @@
 module Types.UUID where
 
 import qualified Data.ByteString as B
+import qualified Data.ByteString.Short as SB
 import qualified Data.Text as T
 import qualified Data.Map as M
 import qualified Data.UUID as U
@@ -54,6 +55,15 @@ instance ToUUID B.ByteString where
                | B.null b = NoUUID
                | otherwise = UUID b
 
+instance FromUUID SB.ShortByteString where
+       fromUUID (UUID u) = SB.toShort u
+       fromUUID NoUUID = SB.empty
+
+instance ToUUID SB.ShortByteString where
+       toUUID b
+               | SB.null b = NoUUID
+               | otherwise = UUID (SB.fromShort b)
+
 instance FromUUID String where
        fromUUID s = decodeBS (fromUUID s)